home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASDEMO2 / ERRDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1988-01-15  |  3KB  |  97 lines
  1. {$R+}
  2. program ErrDemo;
  3.    { A demonstration of error walkback using a user supplied error handler. }
  4. uses Crt;
  5. type
  6.    Str20 = string[20];
  7. const
  8.    ProgDepth = 2; { How deeply nested are your calls ? }
  9.                  { Keep this as small a possible to save space }
  10. var
  11.    TopErr   : integer; { Points to top of ErrStack }
  12.    ErrStack : array[0..ProgDepth] of Str20;
  13.    ErrorPtr : word;
  14.  
  15.    procedure PushErr( Strin: Str20 );
  16.       { Put the procedure name on the stack. }
  17.       { Call right after the Begin in each procedure or dunction }
  18.       { and don't forget to call PopErr at the End. }
  19.    begin
  20.       TopErr := TopErr+1;
  21.       if ( TopErr > ProgDepth ) then begin
  22.          TopErr := ProgDepth;
  23.          ErrStack[TopErr] := Strin;
  24.       end
  25.    end; { of proc PushErr }
  26.  
  27.    procedure PopErr;
  28.       { Take the prodecure name off the stack }
  29.       { Don't forget to call right before the }
  30.       { end of each procedure or fucntion in which you call PushErr }
  31.    begin
  32.       TopErr := TopErr - 1;
  33.       if ( TopErr < 0 ) then begin   { there is a problem }
  34.          TopErr := 0;
  35.          ErrStack[0] := 'ErrStack Corrupted' ;
  36.       end
  37.    end; { of proc PopErr }
  38.  
  39.    procedure ErrHalt( ErrNum, ErrAddr: integer );
  40.       { error handler to demonstarte the walkback }
  41.    var
  42.       I, Row, Col: integer;
  43.    begin
  44.       writeln;
  45.       case Hi(ErrNum) of
  46.          0: writeln( 'User break ' );
  47.          1: writeln( 'I/O Error # ', Lo(ErrNum) );
  48.          2: writeln( 'Run time error # ', Lo(ErrNum) );
  49.       end; { case }
  50.       write( 'Occurred at ADDRESS: ', ErrAddr );
  51.       writeln( ' in ROUTINE: ', ErrStack[TopErr] );
  52.       writeln( 'Press <Return> for Error Walkback: ' );
  53.       readln;
  54.       ClrScr;
  55.       gotoXY( 10, 5 );
  56.       write( '----- WALK BACK -----' );
  57.       Row := 6;
  58.       Col := 3;
  59.       for I := TopErr downto 0 do begin
  60.          gotoXY( Col, Row );
  61.          write( ErrStack[I]:20, ' ', I );
  62.          Row := Row+ 1;
  63.          if ( I = 24 ) then begin
  64.             Row := 6;
  65.             Col := Col + 24 ;
  66.          end;
  67.       end;
  68.       writeln;
  69.       write( 'Execution halted.' );
  70.       Halt;  { or turbo will do it for us }
  71.    end; { of proc ErrHalt }
  72.  
  73.    procedure UserTwo( Arg: real );
  74.    begin
  75.       PushErr( 'UserTwo' );
  76.       writeln( 'Square root of ', Arg, ' is ', Sqrt( Arg ) );
  77.       { this should procedure an error if Arg is < 0! }
  78.       PopErr;
  79.    end; { of proc UserTwo }
  80.  
  81. procedure UserOne( Arg: real );
  82.    begin
  83.       PushErr( 'UserOne' );
  84.       UserTwo( Arg );
  85.       PopErr;
  86.    end; { of proc UserOne }
  87.  
  88. begin
  89.    { Nest two lines initialize ErrStack }
  90.    TopErr := 0;
  91.    ErrStack[0] := 'Main Program' ;
  92.    { Replace turbo's Error Handler }
  93.    ErrorPtr := Ofs(ErrHalt);
  94.    { Do something }
  95.    UserOne(2);   { OK }
  96.    UserOne(-1);  { Error }
  97. end. { of program ErrDemo }